1. with Ada.Exceptions;               use Ada.Exceptions; 
  2. with Ada.Numerics.Discrete_Random; use Ada.Numerics; 
  3. with Ada.Text_IO;                  use Ada.Text_IO; 
  4. with Queue_Pack_Protected_Generic; 
  5. with Sync_Type; 
  6.  
  7. procedure Pipelined_Insersort is 
  8.  
  9.    No_of_Nodes        : constant Positive := 10; 
  10.    Data_Stream_Length : constant Positive := 10_000; 
  11.  
  12.    type Element is range 100 .. 999; 
  13.  
  14.    type Maybe_Element (Valid : Boolean := False) is 
  15.       record 
  16.          case Valid is 
  17.             when True  => Value : Element; 
  18.             when False => null; 
  19.          end case; 
  20.       end record; 
  21.  
  22.    function Invalid_Element             return Maybe_Element is ((Valid => False)); 
  23.    function Valid_Element (E : Element) return Maybe_Element is ((Valid => True, Value => E)); 
  24.  
  25.    package Random_Element is new Discrete_Random (Result_Subtype => Element); 
  26.    use Random_Element; 
  27.  
  28.    Element_Generator : Generator; 
  29.  
  30.    package Element_Queue is new Queue_Pack_Protected_Generic (Element => Element, 
  31.                                                               Size    => Data_Stream_Length); 
  32.    Result_Queue : Element_Queue.Protected_Queue; 
  33.  
  34.    type Node; 
  35.    type Node_Access is access all Node; 
  36.  
  37.    task type Node is 
  38.       entry Link (Next_Node : Node_Access); 
  39.       entry Feed (E         : Maybe_Element); 
  40.    end Node; 
  41.  
  42.    task body Node is 
  43.  
  44.       Next  : Node_Access := null; 
  45.  
  46.       Node_Size : constant Positive := (Data_Stream_Length + No_of_Nodes - 1) / No_of_Nodes; 
  47.  
  48.       package Maybe_Element_Queue is new Queue_Pack_Protected_Generic (Element => Maybe_Element, 
  49.                                                                        Size    => Node_Size); 
  50.       Queue : Maybe_Element_Queue.Protected_Queue; 
  51.  
  52.       package Sync_Maybe_Element is new Sync_Type (Element => Maybe_Element, 
  53.                                                    Default => Invalid_Element); 
  54.  
  55.       Max_Element : Sync_Maybe_Element.Protect; 
  56.  
  57.       task Insert_Elements; 
  58.       task body Insert_Elements is 
  59.  
  60.          subtype Data_Length    is Natural range 0 .. Node_Size; 
  61.          subtype Data_Index     is Natural range 1 .. Node_Size; 
  62.          subtype Data_Index_Ext is Natural range 1 .. Node_Size + 1; 
  63.  
  64.          No_of_Elements : Data_Length := 0; 
  65.  
  66.          Data : array (Data_Index) of Element := (others => Element'Invalid_Value); 
  67.  
  68.          function Pipeline_Filled return Boolean is (No_of_Elements = Node_Size); 
  69.  
  70.       begin 
  71.          Insert_Elements_Loop : loop 
  72.             declare 
  73.                Item : Maybe_Element := Invalid_Element; 
  74.             begin 
  75.                Queue.Dequeue (Item); 
  76.                if Item.Valid then 
  77.                   declare 
  78.                      Spot : Data_Index_Ext := Data_Index_Ext'First; 
  79.                   begin 
  80.                      while Spot <= No_of_Elements and then Data (Spot) < Item.Value loop 
  81.                         Spot := Spot + 1; 
  82.                      end loop; 
  83.                      if Pipeline_Filled and then Spot > No_of_Elements then 
  84.                         Next.all.Feed (Item); 
  85.                      else 
  86.                         if Pipeline_Filled then 
  87.                            Next.all.Feed (Valid_Element (Data (No_of_Elements))); 
  88.                         else 
  89.                            No_of_Elements := No_of_Elements + 1; 
  90.                         end if; 
  91.                         Data (Spot + 1 .. No_of_Elements) := Data (Spot .. No_of_Elements - 1); 
  92.                         Data (Spot) := Item.Value; 
  93.                      end if; 
  94.                   end; 
  95.  
  96.                   if Pipeline_Filled then 
  97.                      Max_Element.Set (Valid_Element (Data (No_of_Elements))); 
  98.                   end if; 
  99.                else 
  100.                   Put_Line ("Node reports" & Data_Length'Image (No_of_Elements) & " values from" & Element'Image (Data (Data'First)) & " to" & Element'Image (Data (No_of_Elements))); 
  101.                   for e of Data (Data'First .. No_of_Elements) loop 
  102.                      Result_Queue.Enqueue (e); 
  103.                   end loop; 
  104.                   if Next /= null then 
  105.                      Next.all.Feed (Item); 
  106.                   end if; 
  107.                   exit Insert_Elements_Loop; 
  108.                end if; 
  109.             end; 
  110.          end loop Insert_Elements_Loop; 
  111.  
  112.       exception 
  113.          when E : others => Put_Line (Exception_Information (E)); 
  114.       end Insert_Elements; 
  115.  
  116.       Node_Active : Boolean := True; 
  117.  
  118.    begin 
  119.       accept Link (Next_Node : Node_Access) do 
  120.          Next := Next_Node; 
  121.       end Link; 
  122.  
  123.       while Node_Active loop 
  124.          accept Feed (E : Maybe_Element) do 
  125.             if E.Valid and then Max_Element.Get.Valid and then E.Value >= Max_Element.Get.Value then 
  126.                Next.all.Feed (E); 
  127.             else 
  128.                Queue.Enqueue (E); 
  129.             end if; 
  130.             Node_Active := E.Valid; 
  131.          end Feed; 
  132.       end loop; 
  133.  
  134.    exception 
  135.       when E : others => Put_Line (Exception_Information (E)); 
  136.    end Node; 
  137.  
  138.    Nodes : array (1 .. No_of_Nodes) of aliased Node; 
  139.  
  140. begin 
  141.    Put_Line ("--- Providing nodes with next-node link"); 
  142.    for n in Nodes'First .. Nodes'Last - 1 loop 
  143.       Nodes (n).Link (Nodes (n + 1)'Access); 
  144.    end loop; 
  145.    Nodes (Nodes'Last).Link (null); 
  146.  
  147.    Put_Line ("--- Feeding in" & Positive'Image (Data_Stream_Length) & " random elements"); 
  148.    Reset (Element_Generator); 
  149.    for i in 1 .. Data_Stream_Length loop 
  150.       Nodes (Nodes'First).Feed (Valid_Element (Random (Element_Generator))); 
  151.    end loop; 
  152.  
  153.    Put_Line ("--- Feeding in end of data stream token"); 
  154.    Nodes (Nodes'First).Feed (Invalid_Element); 
  155.  
  156.    declare 
  157.       Prior_Result, Result : Element := Element'Invalid_Value; 
  158.    begin 
  159.       Result_Queue.Dequeue (Prior_Result); 
  160.       for i in 1 .. Data_Stream_Length - 1 loop 
  161.          Result_Queue.Dequeue (Result); 
  162.          if Prior_Result > Result then 
  163.             raise Program_Error with "Found out of order elements"; 
  164.          end if; 
  165.          Prior_Result := Result; 
  166.       end loop; 
  167.    end; 
  168.  
  169.    Put_Line ("--- Terminated with an ordered list"); 
  170.  
  171. end Pipelined_Insersort;